home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / vmmngr.arc / VMMTEST1.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-07-16  |  3.7 KB  |  128 lines
  1. Program VmmTest1;
  2. {-Test program for VMM. This test is much more severe than real world}
  3. { applications. So don't be afraid by the time it requires to execute}
  4.  
  5. uses
  6. {$IFDEF HugeAlloc} {You must have Brian Foley's TPALLOC package to try this}
  7.   TpAlloc,
  8. {$ENDIF}
  9.   Vmmngr;
  10.  
  11. const
  12.   AMax = 200;
  13.   Size1 = 2500;
  14.   Size2 = 5000;
  15.   Size3 = 7500;
  16.   HugeSize = 150000;
  17.   DefEmsToKeep = 32; {512k}
  18.   NewRamSize = 32767;
  19.  
  20. type
  21.   Block1 = array [1..Size1] of byte;
  22.   Block2 = array [1..Size2] of byte;
  23.   Block3 = array [1..Size3] of byte;
  24.   Block1Ptr = ^Block1;
  25.   Block2Ptr = ^Block2;
  26.   Block3Ptr = ^Block3;
  27.  
  28. var
  29.   VM : Vmm;
  30.   A1 : array [1..AMax] of Block1Ptr;
  31.   A2 : array [1..AMax] of Block2Ptr;
  32.   A3 : array [1..AMax] of Block3Ptr;
  33.   i  : Byte;
  34.  
  35.   procedure DoClear;
  36.   begin
  37.     Writeln('Clearing Ram area...');
  38.     if not VM.ClearRamArea then
  39.       Writeln('Some blocks are still locked or an error occured.');
  40.     Writeln('RamMaxAvail : ', VM.RamMaxAvail);
  41.   end;
  42.  
  43. begin
  44. {$IFDEF HugeAlloc}
  45.   UserGetMem := HugeGetMem;
  46.   UserFreeMem := HugeFreeMem;
  47.   if not VM.InitCustom(HugeSize,
  48.                        DefIncr,
  49.                        DefFreeEntries div 2,
  50.                        DefFreeEntries,
  51.                        DefQueueEntries,
  52.                        DefEmsToKeep,
  53.                        DefDskToKeep,
  54.                        'VMM.SWP') then begin
  55.     Writeln('Failed to open virtual memory manager');
  56.     Halt;
  57.   end
  58. {$ELSE}
  59.   if not VM.Init('VMM.SWP') then begin
  60.     Writeln('Failed to open virtual memory manager');
  61.     Halt;
  62.   end
  63. {$ENDIF}
  64.   else begin
  65.     Writeln('Virtual memory manager initialized');
  66.     Writeln('RamMaxAvail : ', VM.RamMaxAvail);
  67.   end;
  68.   (*
  69.   VM.vmOptionsOff(vmDeleteSwap);  {Try this if you want to browse the swap file}
  70.   VM.vmOptionsOff(vmUseDsk);      {Try this to work on disk only}
  71.   VM.vmOptionsOff(vmUseEms);      {Try this to work in Ems only}
  72.   {Disabling both options is not possible}
  73.   *)
  74.   {Link object to dereference handler}
  75.   VM.LinkToDerefHandler;
  76.   {Allocate AMax blocks of each type}
  77.   Writeln('Allocating memory blocks... (',
  78.           (Size1+Size2+Size3)*AMax,
  79.           ' bytes thru ',
  80.           AMax*3,
  81.           ' pointers)');
  82.   for i := 1 to AMax do begin
  83.     VM.GetMemV(A1[i], SizeOf(Block1));
  84.     if A1[i] <> nil then
  85.       FillChar(VmmDrf(A1[i])^, SizeOf(Block1), i);
  86.     VM.GetMemV(A2[i], SizeOf(Block2));
  87.     if A2[i] <> nil then
  88.       FillChar(VmmDrf(A2[i])^, SizeOf(Block2), i);
  89.     VM.GetMemV(A3[i], SizeOf(Block3));
  90.     if A3[i] <> nil then
  91.       FillChar(VmmDrf(A3[i])^, SizeOf(Block3), i);
  92.   end;
  93.   Writeln('Dereferencing all pointers again...');
  94.   for i := AMax downto 1 do begin
  95.     if A1[i] <> nil then
  96.       FillChar(VmmDrf(A1[i])^, SizeOf(Block1), 255-i);
  97.     if A2[i] <> nil then
  98.       FillChar(VmmDrf(A2[i])^, SizeOf(Block2), 255-i);
  99.     if A3[i] <> nil then
  100.       FillChar(VmmDrf(A3[i])^, SizeOf(Block3), 255-i);
  101.   end;
  102.   DoClear;
  103.   Writeln('Locking a block which is likely not in Ram...');
  104.   if not VM.Lock(A3[AMax], true) then
  105.     Writeln('Could not lock the block in Ram.')
  106.   else begin
  107.     DoClear;
  108.     Writeln('Dereferencing the locked pointer...');
  109.     FillChar(VmmDrf(A3[AMax])^, SizeOf(Block3), 0);
  110.     Writeln('Clearing Ram area again...');
  111.     DoClear;
  112.     if not VM.Lock(A3[AMax], false) then
  113.       Writeln('Could not unlock the block in Ram.');
  114.   end;
  115.   Writeln('Deallocating blocks...');
  116.   for i := 1 to AMax do begin
  117.     if A1[i] <> nil then
  118.       VM.FreeMemV(A1[i]);
  119.     if A2[i] <> nil then
  120.       VM.FreeMemV(A2[i]);
  121.     if A3[i] <> nil then
  122.       VM.FreeMemV(A3[i]);
  123.   end;
  124.   Writeln('Destroying memory manager...');
  125.   VM.Done;
  126.   Writeln('Done.');
  127. end.
  128.